i_log_222 <- 1
for(f in 1:length(geo_list)) {
tp <- geo_list[[f]]$tipo
vl <- geo_list[[f]]$val
nm <- geo_list[[f]]$nombre
f_ex <- 14 + f - 1
sub_row <- if(tp == "Nacional") {
dis_ing
} else if(tp == "CANT_URB") {
dis_ing[
dis_ing$variables$AREA_COD == 1 &
dis_ing$variables$CANT_COD == vl,
]
} else {
dis_ing[
dis_ing$variables[[tp]] == vl,
]
}
r_total <- evaluar_y_pintar(
hoja = "CUADRO 2.2.2",
diseno_sub = sub_row,
formula_var = ~ing_cor_tot,
fila = f_ex,
col = 4
)
LOG_222[[i_log_222]] <- data.frame(
Dom = nm,
Tramo = "Total",
Variable_Tramo = NA_character_,
Criterio_Tramo = "Total del dominio",
Col = 4,
Val = r_total$Val,
n = r_total$n,
gl = r_total$gl,
CV = r_total$cv,
Calidad = r_total$Calidad,
Motivo = r_total$Motivo
)
i_log_222 <- i_log_222 + 1
for(t in 1:6) {
c_ex <- 4 + t
r_tramo <- evaluar_y_pintar(
hoja = "CUADRO 2.2.2",
diseno_sub = sub_row[
!is.na(sub_row$variables$Tramo_Ing_Mon_6) &
sub_row$variables$Tramo_Ing_Mon_6 == t,
],
formula_var = ~ing_cor_tot,
fila = f_ex,
col = c_ex
)
LOG_222[[i_log_222]] <- data.frame(
Dom = nm,
Tramo = t,
Variable_Tramo = "ing_mon_cor",
Criterio_Tramo = "6 tramos: 1,2,3,4,5 y 5 SBU o más",
Col = c_ex,
Val = r_tramo$Val,
n = r_tramo$n,
gl = r_tramo$gl,
CV = r_tramo$cv,
Calidad = r_tramo$Calidad,
Motivo = r_tramo$Motivo
)
i_log_222 <- i_log_222 + 1
}
for(c_borrar in 11:14) {
openxlsx::writeData(wb, "CUADRO 2.2.2", NA, startRow = f_ex, startCol = c_borrar)
openxlsx::addStyle(wb, "CUADRO 2.2.2", style_blanco, rows = f_ex, cols = c_borrar)
}
}
# ==============================================================================
# 10. CUADRO 2.2.3
# INGRESO CORRIENTE PROMEDIO MENSUAL PER CÁPITA POR DECILES
# ==============================================================================
cat("Calculando Cuadro 2.2.3...\n")
LOG_223 <- list()
i_log_223 <- 1
for(f in 1:length(geo_list)) {
tp <- geo_list[[f]]$tipo
vl <- geo_list[[f]]$val
nm <- geo_list[[f]]$nombre
f_ex <- 14 + f - 1
sub_data <- if(tp == "Nacional") {
INGRESOSH
} else if(tp == "CANT_URB") {
INGRESOSH %>%
filter(AREA_COD == 1, CANT_COD == vl)
} else {
INGRESOSH %>%
filter(.data[[tp]] == vl)
}
if(nrow(sub_data) > 0) {
sub_data_per <- calcular_ntiles_spss(
data = sub_data,
variable = "ing_cor_per",
nombre_decil = "Decil_Local",
peso = "Fexp",
grupos = 10,
desempate = "Identif_hog",
etiqueta = paste0(nm, " - ingreso corriente per cápita"),
mostrar_control = FALSE
)
dis_loc_per <- svydesign(
id = ~Identif_upm,
strata = ~estrato,
weights = ~Fexp,
data = sub_data_per
)
r_total <- evaluar_y_pintar(
hoja = "CUADRO 2.2.3",
diseno_sub = dis_loc_per,
formula_var = ~ing_cor_per,
fila = f_ex,
col = 4
)
LOG_223[[i_log_223]] <- data.frame(
Dom = nm,
Decil = "Total",
Col = 4,
Val = r_total$Val,
n = r_total$n,
gl = r_total$gl,
CV = r_total$cv,
Calidad = r_total$Calidad,
Motivo = r_total$Motivo
)
i_log_223 <- i_log_223 + 1
for(d in 1:10) {
c_ex <- 4 + d
r_decil <- evaluar_y_pintar(
hoja = "CUADRO 2.2.3",
diseno_sub = dis_loc_per[
dis_loc_per$variables$Decil_Local == d,
],
formula_var = ~ing_cor_per,
fila = f_ex,
col = c_ex
)
LOG_223[[i_log_223]] <- data.frame(
Dom = nm,
Decil = d,
Col = c_ex,
Val = r_decil$Val,
n = r_decil$n,
gl = r_decil$gl,
CV = r_decil$cv,
Calidad = r_decil$Calidad,
Motivo = r_decil$Motivo
)
i_log_223 <- i_log_223 + 1
}
} else {
for(c_ex in 4:14) {
openxlsx::writeData(wb, "CUADRO 2.2.3", "-", startRow = f_ex, startCol = c_ex)
openxlsx::addStyle(wb, "CUADRO 2.2.3", style_red, rows = f_ex, cols = c_ex)
}
}
}
# ==============================================================================
# 11. CUADRO 2.2.4
# INGRESO CORRIENTE PROMEDIO MENSUAL PER CÁPITA POR TRAMOS DE INGRESO MONETARIO CORRIENTE
# ==============================================================================
cat("Calculando Cuadro 2.2.4...\n")
LOG_224 <- list()
i_log_224 <- 1
for(f in 1:length(geo_list)) {
tp <- geo_list[[f]]$tipo
vl <- geo_list[[f]]$val
nm <- geo_list[[f]]$nombre
f_ex <- 14 + f - 1
sub_row <- if(tp == "Nacional") {
dis_ing
} else if(tp == "CANT_URB") {
dis_ing[
dis_ing$variables$AREA_COD == 1 &
dis_ing$variables$CANT_COD == vl,
]
} else {
dis_ing[
dis_ing$variables[[tp]] == vl,
]
}
r_total <- evaluar_y_pintar(
hoja = "CUADRO 2.2.4",
diseno_sub = sub_row,
formula_var = ~ing_cor_per,
fila = f_ex,
col = 4
)
LOG_224[[i_log_224]] <- data.frame(
Dom = nm,
Tramo = "Total",
Variable_Tramo = NA_character_,
Criterio_Tramo = "Total del dominio",
Col = 4,
Val = r_total$Val,
n = r_total$n,
gl = r_total$gl,
CV = r_total$cv,
Calidad = r_total$Calidad,
Motivo = r_total$Motivo
)
i_log_224 <- i_log_224 + 1
for(t in 1:6) {
c_ex <- 4 + t
r_tramo <- evaluar_y_pintar(
hoja = "CUADRO 2.2.4",
diseno_sub = sub_row[
!is.na(sub_row$variables$Tramo_Ing_Mon_6) &
sub_row$variables$Tramo_Ing_Mon_6 == t,
],
formula_var = ~ing_cor_per,
fila = f_ex,
col = c_ex
)
LOG_224[[i_log_224]] <- data.frame(
Dom = nm,
Tramo = t,
Variable_Tramo = "ing_mon_cor",
Criterio_Tramo = "6 tramos: 1,2,3,4,5 y 5 SBU o más",
Col = c_ex,
Val = r_tramo$Val,
n = r_tramo$n,
gl = r_tramo$gl,
CV = r_tramo$cv,
Calidad = r_tramo$Calidad,
Motivo = r_tramo$Motivo
)
i_log_224 <- i_log_224 + 1
}
for(c_borrar in 11:14) {
openxlsx::writeData(wb, "CUADRO 2.2.4", NA, startRow = f_ex, startCol = c_borrar)
openxlsx::addStyle(wb, "CUADRO 2.2.4", style_blanco, rows = f_ex, cols = c_borrar)
}
}
# ==============================================================================
# 12. CUADRO 2.2.5
# INGRESO CORRIENTE PROMEDIO MENSUAL POR SEXO, EDAD,
# NIVEL DE INSTRUCCIÓN Y AUTOIDENTIFICACIÓN ÉTNICA
# ==============================================================================
cat("Calculando Cuadro 2.2.5...\n")
dis_demo <- svydesign(
id = ~Identif_upm,
strata = ~estrato,
weights = ~Fexp,
data = INGRESOSH
)
cols_demo <- list(
# Nacional
list(var = "Nacional", val = 1, col = 4),
# Sexo
list(var = "Sexo_JH", val = "Hombre", col = 5),
list(var = "Sexo_JH", val = "Mujer", col = 6),
# Grupos de edad
list(var = "GRUPO_EDAD_JH", val = "Menor de 25 años", col = 7),
list(var = "GRUPO_EDAD_JH", val = "De 25 a 44 años", col = 8),
list(var = "GRUPO_EDAD_JH", val = "De 45 a 64 años", col = 9),
list(var = "GRUPO_EDAD_JH", val = "De 65 años y más", col = 10),
# Nivel de instrucción
list(var = "NI_JH", val = "Ninguno", col = 11),
list(var = "NI_JH", val = "Primaria", col = 12),
list(var = "NI_JH", val = "Educación General Básica (EGB)", col = 13),
list(var = "NI_JH", val = "Secundaria", col = 14),
list(var = "NI_JH", val = "Bachillerato", col = 15),
list(var = "NI_JH", val = "Superior(No universitaria)", col = 16),
list(var = "NI_JH", val = "Educación Superior (Universidad)", col = 17),
# Autoidentificación étnica
list(var = "N_AUTOIDEN_JH", val = "Indigena", col = 18),
list(var = "N_AUTOIDEN_JH", val = "Afro", col = 19),
list(var = "N_AUTOIDEN_JH", val = "Mestizo", col = 20),
list(var = "N_AUTOIDEN_JH", val = "Blanco", col = 21),
list(var = "N_AUTOIDEN_JH", val = "Otro", col = 22)
)
LOG_DEMO_225 <- list()
i_log_225 <- 1
for(f in 1:length(geo_list)) {
tp <- geo_list[[f]]$tipo
vl <- geo_list[[f]]$val
nm <- geo_list[[f]]$nombre
f_ex <- 14 + f - 1
sr <- if(tp == "Nacional") {
dis_demo
} else if(tp == "CANT_URB") {
dis_demo[
dis_demo$variables$AREA_COD == 1 &
dis_demo$variables$CANT_COD == vl,
]
} else {
dis_demo[
dis_demo$variables[[tp]] == vl,
]
}
for(col in cols_demo) {
sc <- if(col$var == "Nacional") {
sr
} else {
sr[
!is.na(sr$variables[[col$var]]) &
sr$variables[[col$var]] == col$val,
]
}
r1 <- evaluar_y_pintar(
hoja = "CUADRO 2.2.5",
diseno_sub = sc,
formula_var = ~ing_cor_tot,
fila = f_ex,
col = col$col
)
LOG_DEMO_225[[i_log_225]] <- data.frame(
Dom = nm,
Var = col$var,
Categoria = col$val,
Col = col$col,
Val = r1$Val,
n = r1$n,
gl = r1$gl,
CV = r1$cv,
Calidad = r1$Calidad,
Motivo = r1$Motivo
)
i_log_225 <- i_log_225 + 1
}
}
# ==============================================================================
# 13. CUADRO 2.2.6
# INGRESO CORRIENTE PER CÁPITA MENSUAL POR SEXO, EDAD,
# NIVEL DE INSTRUCCIÓN Y AUTOIDENTIFICACIÓN ÉTNICA
# ==============================================================================
cat("Calculando Cuadro 2.2.6...\n")
LOG_DEMO_226 <- list()
i_log_226 <- 1
for(f in 1:length(geo_list)) {
tp <- geo_list[[f]]$tipo
vl <- geo_list[[f]]$val
nm <- geo_list[[f]]$nombre
f_ex <- 14 + f - 1
sr <- if(tp == "Nacional") {
dis_demo
} else if(tp == "CANT_URB") {
dis_demo[
dis_demo$variables$AREA_COD == 1 &
dis_demo$variables$CANT_COD == vl,
]
} else {
dis_demo[
dis_demo$variables[[tp]] == vl,
]
}
for(col in cols_demo) {
sc <- if(col$var == "Nacional") {
sr
} else {
sr[
!is.na(sr$variables[[col$var]]) &
sr$variables[[col$var]] == col$val,
]
}
r2 <- evaluar_y_pintar(
hoja = "CUADRO 2.2.6",
diseno_sub = sc,
formula_var = ~ing_cor_per,
fila = f_ex,
col = col$col
)
LOG_DEMO_226[[i_log_226]] <- data.frame(
Dom = nm,
Var = col$var,
Categoria = col$val,
Col = col$col,
Val = r2$Val,
n = r2$n,
gl = r2$gl,
CV = r2$cv,
Calidad = r2$Calidad,
Motivo = r2$Motivo
)
i_log_226 <- i_log_226 + 1
}
}
# ==============================================================================
# 14. GUARDAR EXCEL Y RESPALDO
# ==============================================================================
cat("Guardando resultados...\n")
openxlsx::saveWorkbook(
wb,
"Tabulados 2025.xlsx",
overwrite = TRUE
)
# Respaldo desactivado: no se genera archivo adicional al Excel final.
cat("Proceso terminado correctamente.\n")
rm(list = ls())
gc()
# ==============================================================================
# SCRIPT MAESTRO: RUN_ALL.R
# PRODUCCIÓN FINAL ENIGHUR
# Resultado permitido al finalizar: Tabulados 2025.xlsx
# Se conservan únicamente los archivos .sav originales y los scripts .R.
# Se eliminan todos los .rds temporales y cualquier Excel auxiliar.
# ==============================================================================
cat("\n=======================================================\n")
cat("   INICIANDO SISTEMA AUTOMATIZADO DE TABULADOS ENIGHUR   \n")
cat("=======================================================\n")
# ------------------------------------------------------------------------------
# FUNCIONES LOCALES DEL RUN
# ------------------------------------------------------------------------------
source_seguro <- function(archivo) {
if(!file.exists(archivo)) {
stop(paste("No existe el script:", archivo))
}
env_script <- new.env(parent = .GlobalEnv)
tryCatch(
{
source(archivo, local = env_script)
},
error = function(e) {
stop(
paste0("Error en ", archivo, ": ", conditionMessage(e)),
call. = FALSE
)
}
)
rm(env_script)
gc()
invisible(TRUE)
}
limpiar_temporales_enighur <- function(
directorio = getwd(),
exigir_excel_final = TRUE,
excel_final = "Tabulados 2025.xlsx"
) {
ruta_excel_final <- file.path(directorio, excel_final)
if(isTRUE(exigir_excel_final) && !file.exists(ruta_excel_final)) {
stop("No se encontró el Excel final; no se eliminan temporales.")
}
archivos <- list.files(directorio, full.names = TRUE, all.files = FALSE)
nombres  <- basename(archivos)
# Producción final:
# - eliminar todos los .rds temporales;
# - eliminar cualquier Excel auxiliar;
# - conservar únicamente Tabulados 2025.xlsx como archivo Excel final;
# - NO eliminar .sav originales ni scripts .R.
eliminar_rds <- grepl("\\.rds$", nombres, ignore.case = TRUE)
eliminar_xlsx_aux <- grepl("\\.xlsx$", nombres, ignore.case = TRUE) &
nombres != excel_final
eliminar <- archivos[eliminar_rds | eliminar_xlsx_aux]
if(length(eliminar) > 0) {
cat("\nArchivos temporales eliminados:\n")
cat(paste0(" - ", basename(eliminar), collapse = "\n"), "\n")
unlink(eliminar, force = TRUE)
} else {
cat("\nNo se encontraron archivos temporales para eliminar.\n")
}
invisible(eliminar)
}
# ------------------------------------------------------------------------------
# EJECUCIÓN COMPLETA DE PRODUCCIÓN
# ------------------------------------------------------------------------------
tryCatch({
cat("\n>>> CONVERSIÓN INICIAL .sav A .rds TEMPORALES <<<\n")
source_seguro("00_CONVERTIR_BASES.R")
gc()
cat("\n>>> PREPARACIÓN DE BASES TEMPORALES (.rds) <<<\n")
source_seguro("00_PREPARACION_BASES.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 1.1 Y 1.2: VIVIENDA Y DEMOGRAFÍA <<<\n")
source_seguro("01.1_VIVIENDA.R")
source_seguro("01.2_DEMOGRAFIA.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 2.1: ESTRUCTURA DE INGRESOS Y GASTOS <<<\n")
source_seguro("02.1_ESTRUCTURA_ING_GAS.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 2.2: INGRESO CORRIENTE MENSUAL <<<\n")
source_seguro("02.2_INGRESOS_MENSUAL.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 2.3: GASTO CORRIENTE MENSUAL <<<\n")
source_seguro("02.3_GASTOS_MENSUAL.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 2.4: GASTO DE CONSUMO MENSUAL <<<\n")
source_seguro("02.4_GASTO_CONSUMO.R")
gc()
cat("\n>>> EJECUTANDO PUNTO 3.1 Y 3.2: COMPOSICIÓN DEL GASTO <<<\n")
source_seguro("03.1_COMPOSICION_GASTO.R")
gc()
cat("\n>>> LIMPIEZA FINAL OBLIGATORIA <<<\n")
limpiar_temporales_enighur(
directorio = getwd(),
exigir_excel_final = TRUE,
excel_final = "Tabulados 2025.xlsx"
)
gc()
cat("\n=======================================================\n")
cat(" !TABULADOS LISTOS.\n")
cat(" Solo debe quedar como Excel final: 'Tabulados 2025.xlsx'.\n")
cat(" Los .sav originales se conservan. Los .rds temporales fueron eliminados.\n")
cat("=======================================================\n")
}, error = function(e) {
cat("\n=======================================================\n")
cat(" ERROR EN LA EJECUCIÓN.\n")
cat(" Por seguridad, se intentará eliminar .rds y Excel auxiliares.\n")
try(
limpiar_temporales_enighur(
directorio = getwd(),
exigir_excel_final = FALSE,
excel_final = "Tabulados 2025.xlsx"
),
silent = TRUE
)
cat(" Detalle: ", conditionMessage(e), "\n", sep = "")
cat("=======================================================\n")
stop(e)
})
